######################################################################
# Time-stamp: <05/09/09 11:06:22 ostolop>
######################################################################
package EP::EPC::Core::Component;

use EP::Config;

use EP::Common;
use EP::Common::DB;
use EP::Common::General;
use EP::Common::Error qw ( :try );

use EP::Common::DBI::Folder;
use EP::Common::DBI::Action;
use EP::Common::DBI::Dataset;
use EP::Common::DBI::Component;
use EP::Common::DBI::Group;
use EP::Common::DBI::User_Group;
use EP::Common::DBI::User;
use EP::Common::DBI::Session;
use EP::Common::DBI::Action_Metadata;

sub new {
  my $proto = shift;
  my ( $query, $CD, $epc_id ) = @_;
  my $class = ref ( $proto ) || $proto;
  my $self = {};

  bless $self, $class;
  $self->initialize ( $query, $CD, $epc_id );

  return $self;
}

sub initialize {
  my $self = shift;
  my ( $query, $CD, $epc_id ) = @_;

  $self->{query} = $query;
  $self->{CD}    = $CD;
  $self->{EPC_ID} = $epc_id;

  $self->{core_dispatcher} = $CD;

  $self->{session}      = $CD->{session}; # copy the current session reference here for convenience.
  $self->{current_user} = $CD->{session}->owner;

  return if not $self->{current_user};

  my $src_dataset;

  if ( $self->{query}->param ( "dst_dataset_id") ) {
    $src_dataset = EP::Common::DBI::Dataset->retrieve ( $self->{query}->param ( "dst_dataset_id" ) );
    warn "Derived source dataset id ($src_dataset) from the previous component's dst_dataset_id" if DEBUG;
  }
  elsif ( $self->{query}->param ( "current_metadata_selection" ) ) {
    my $metadata = EP::Common::DBI::Action_Metadata->retrieve ( $self->{query}->param ( "current_metadata_selection" ) );
    if ( $metadata->type eq "xml/table" ) {
      my $new_action = EP::EPC::Core::Data_Management::export_dataset ( $self, $self->{query}->param("current_metadata_selection") );
      $src_dataset = $new_action->dst_dataset;
      warn "Derived source dataset from xml/table metadata!" if DEBUG;
    } elsif ( $metadata->type eq "text/plain" and $metadata->name =~ /clustering_\d+/ ) {
	  warn "Will try to derive source dataset from a k-means saved subcluster...";
	  my $new_action = EP::EPC::Core::Data_Management::export_dataset ( $self, $self->{query}->param("current_metadata_selection") );
      $src_dataset = $new_action->dst_dataset;
	} else {
      $src_dataset = $metadata->action->dst_dataset;
      warn "Derived source dataset id ($src_dataset) from parent of the selected action metadata!" if DEBUG;
    }
  }
  elsif ( $self->{query}->param ( "current_action_id" ) ) {
    $src_dataset = EP::Common::DBI::Action->retrieve ( $self->{query}->param ( "current_action_id" ) )->dst_dataset;
    warn "Derived source dataset id ($src_dataset) from the current action id" if DEBUG;
  }
  elsif ( $self->{query}->param ( "current_root_dataset_id" ) ) {
    $src_dataset = EP::Common::DBI::Dataset->retrieve ( $self->{query}->param ( "current_root_dataset_id" ) );
#    warn "Derived source dataset id from the current root dataset id" if DEBUG;
  }
  else {
    # try to get it from the database
    $src_dataset = $self->{session}->current_action->dst_dataset if $self->{session}->current_action;

    if ( not $src_dataset ) {
      $src_dataset = $self->{session}->current_root_dataset;
    }

#    die "No source dataset supplied to component" if not $src_dataset;
  }

  $self->{src_dataset} = $src_dataset;
}

sub process_component {
  my $self = shift;
  my $query = $self->{query};

  if ( $query->param ( "action" ) eq "cancel_last_action" ) {
    $self->cancel_last_action ();
  }

  $self->{CD}->{process_result} = $query->Vars;
  return $self->record_analysis_history ();
}

# sub: record_analysis_history
#   Creates a new <EP::Common::DBI::Action> and thus records the analysis history.
# parameters:
#   Hash of parameters. If *new_root_dataset* is true, then the action will become a root action and the new dataset
#   will become the root dataset for the user.
# returns:
#   New <EP::Common::DBI::Action> object.
sub record_analysis_history {
  my $self  = shift;
  my %params = @_;

  if ( not $self->{CD}->{process_result} ) {
    warn "Cannot record analysis history - no process_result present, perhaps unsuccessful execution of EPC?";
    return 0;
  }

  my $parent_action_id = $self->{session}->current_action->id if $self->{session}->current_action;

  my $cid  = $self->{EPC_ID};
  my $component_id     = $cid || $self->{CD}->{process_component_id};

  my $src_dataset_id   = $self->{CD}->{process_result}->{src_dataset_id};
  my $dst_dataset_id   = $self->{CD}->{process_result}->{dst_dataset_id};

  my $root_dataset_id  = $self->{session}->current_root_dataset->id if $self->{session}->current_root_dataset;

  $parent_action_id = undef          if $params{new_root_dataset} or $parent_action_id eq '';
  $root_dataset_id = $dst_dataset_id if $params{new_root_dataset};

  my $new_action_elts = { component     => $component_id,
			  dst_dataset   => $dst_dataset_id,
			  root_dataset  => $root_dataset_id,
			  parent_action => $parent_action_id
			};

  my $metadata = $self->get_action_metadata();
  die "Action metadata must contain process_result!" if not exists $metadata->{process_result};

#  $new_action_elts->{metadata} = new EP::Common::DBI::Action::Metadata ( $metadata );
  my $new_action = EP::Common::DBI::Action->create ( $new_action_elts );

  while ( ( $output_name, $output ) = each %{$metadata->{process_result}} ) {
    EP::Common::DBI::Action_Metadata->create ( { action => $new_action,
						 name   => $output_name,
						 type   => $output->{type},
						 uuid   => $output->{uuid},
						 label  => $output->{label},
						 value  => $output->{value} } ) if ref ( $output ) eq "HASH";

    EP::Common::DBI::Action_Metadata->create ( { action => $new_action,
						 name   => $output_name,
						 value  => $output } )          if ref ( $output ) ne "HASH";
  }

  my $params = $self->{query}->Vars;
  while ( ($paramname, $paramval) = each %$params ) {
    EP::Common::DBI::Action_Metadata->create ( { action => $new_action,
						 name   => $paramname,
						 type   => "input",
						 value  => $paramval } );
  }

  $self->{session}->current_action ( $new_action );
  $self->{session}->current_root_dataset ( $root_dataset_id ) if $params{new_root_dataset};

  $self->{CD}->{process_result}->{current_action_id} = $new_action;

  return $new_action;
}

# sub: get_action_metadata
#   Returns the action metadata. At the very least, the metadata should contain a 'process_result' element. Methods
#   overriding below should take care of that.
sub get_action_metadata {
  my $self = shift;

  my $metadata = { process_result => $self->{CD}->{process_result} };
  return $metadata;
}

sub read_tree_data_from_file {
  my ($file) = shift;

  my @DATA;

  open ( CLUSTER, $file ) or die "Couldn't open the hierarchical clustering file $file: $!\n";
  while (<CLUSTER>) {
    next if /^\s*#/;

    # From the original clustering output
    my @data_row = split /\s+/;
    push @DATA, \@data_row;
  }
  close CLUSTER;

  return \@DATA;
}

sub read_in_tree {
  my $self = shift;
  my ( $tree_data ) = @_;

  my %LL;
  my @TREEDOWN;
  my $TREENODE = 0;

  my (@TREE_L, @TREE_R, %DIST, %SUBTREE, @ORIG_TREE);

  my $DATA;
  $DATA = read_tree_data_from_file ( $tree_data ) if -f $tree_data;
  $DATA = $tree_data if ref ( $tree_data ) eq "ARRAY";

  die "Couldn't read in tree data!" if not $DATA;


  foreach my $data_row ( @{$DATA} ) {
    # From the original clustering output
    my ( $LH, $RH, $LHS, $RHS, $D ) = @$data_row;

    $TREEDOWN[1] = [ 0, $LHS + $RHS ] if not exists $TREEDOWN[1];

    # @TREEDOWN  - how much space was reserved for subtree starting with that node
    my ( $TREENODE, $count ) = @{$TREEDOWN[$LH]};

    # $LHTREE, $RHTREE, $TREENODE -  tree-node id's on tree structure
    my $LHTREE = $TREENODE + 1;
    my $RHTREE = $TREENODE + nodes_in_subtree($LHS) + 1;

    ( $TREE_L   [$TREENODE], $TREE_R   [$TREENODE] ) = ( $LHTREE,           $RHTREE);
    ( $ORIG_TREE[$LHTREE  ], $ORIG_TREE[$RHTREE  ] ) = ( $LH,               $RH );
    ( $TREEDOWN [$LH      ], $TREEDOWN [$RH      ] ) = ( [ $LHTREE, $LHS ], [ $RHTREE, $RHS ] );

    $DIST{"$LH:$RH"}    = $D;
    $SUBTREE{"$LH:$RH"} = $TREENODE;

    # left leaf
    ( $TREE_L[$LHTREE], $TREE_R[$LHTREE] ) = ( 0, $LH ) if $LHS == 1;

    # right leaf
    ( $TREE_L[$RHTREE], $TREE_R[$RHTREE] ) = ( 0, $RH ) if $RHS == 1;
  }

  $self->{nr_leaves} = $$DATA[0][2] + $$DATA[0][3];
  $self->{TREE_L} = \@TREE_L;
  $self->{TREE_R} = \@TREE_R;
  $self->{DIST}   = \%DIST;
  $self->{SUBTREE} = \%SUBTREE;
  $self->{ORIG_TREE} = \@ORIG_TREE;

  $self->{data} = $DATA;
}

sub nodes_in_subtree {
  my ( $leaves ) = $_[0];
  return $leaves * 2 - 1;
}

sub treewalk {
  my $self = shift;
  my ($N) = @_;

  $N = 0 if not $N;

  if ( $self->{TREE_L}->[$N] == 0 ) {
    my $leaf = $self->{TREE_R}->[$N];
    return $leaf - 1;		# subtract 1 because indices should be zero-based
  }

  return ( treewalk ( $self, $self->{TREE_L}->[$N] ),
	   treewalk ( $self, $self->{TREE_R}->[$N] ) );
}

sub left_treewalk {
  my $self = shift;
  my ($N) = @_;

  $N = 0 if not $N;

  if ( $self->{TREE_L}->[$N] == 0 ) {
    my $leaf = $self->{TREE_R}->[$N];
    return $leaf - 1;		# subtract 1 because indices should be zero-based
  }

  return ( $self->left_treewalk ( $self->{TREE_L}->[$N] ) );
}

sub right_treewalk {
  my $self = shift;
  my ($N) = @_;

  $N = 0 if not $N;

  if ( $self->{TREE_L}->[$N] == 0 ) {
    my $leaf = $self->{TREE_R}->[$N];
    return $leaf - 1;		# subtract 1 because indices should be zero-based
  }

  return ( $self->right_treewalk ( $self->{TREE_R}->[$N] ) );
}

sub get_gene_ids_from_cluster {
  my $self = shift;

  my ( $sc ) = @_;

  my ( $action_id, $direction, $buf, $cluster ) = split /_/, $sc;
  my ( $left, $right ) = split /:/, $cluster;

  my ($clustering) = EP::Common::DBI::Action_Metadata->search ( { action => $action_id, name => $direction . "s_clust" } );

  my $clustering_file = $clustering->value;
  $self->read_in_tree ( $EP::Config::h->{EPNG_USRDATA_PATH} . "/" . $clustering->action->dst_dataset->folder->location . "/" . $clustering->value );

  my @subcluster_gene_ids = treewalk ( $self, $self->{SUBTREE}->{$cluster} );
  return \@subcluster_gene_ids;
}

sub check_NAs {
  my $self = shift;
  my ( $src_dataset_id ) = @_;

  my $dataset = EP::Common::DB::get_dataset ( { id => $src_dataset_id} )->{0};
  chomp ( my $hasNAs = `grep -c NA $EP::Config::h->{EPNG_USRDATA_PATH}/$dataset->{folder}/$dataset->{filename}` );

  if ( $hasNAs >= 1 ) {
    throw EP::Common::Error ( -value => CLU_DATASET_HAS_NAS, -err_args => [ "this data" ] );
  }
}

sub cancel_last_action {
  my $self = shift;

  my $username = $self->{CD}->{session}->{username};
  my $last_action = $self->{session}->current_action;

  warn "Going to delete action $last_action" if DEBUG;
  $self->{session}->current_action ( undef );
  $self->{session}->status ( "Canceling last action " . $last_action->component->name );

  # delete all files associated with this action on disk
  EP::Common::Data::delete_action ( $last_action );

  # update the database
  $last_action->delete;
}

1;
